home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Language/OS - Multiplatform Resource Library
/
LANGUAGE OS.iso
/
lisp
/
kcl
/
akcl
/
kcl.lha
/
cmpnew
/
cmpvs.c
< prev
next >
Wrap
C/C++ Source or Header
|
1987-06-04
|
5KB
|
216 lines
/* (C) Copyright Taiichi Yuasa and Masami Hagiya, 1984. All rights reserved. */
#include <cmpinclude.h>
#include "cmpvs.h"
init_cmpvs(start,size,data)char *start;int size;object data;
{ register object *base=vs_top;register object *sup=base+VM2;vs_check;
Cstart=start;Csize=size;Cdata=data;set_VV(VV,VM1,data);
(void)(putprop(VV[0],VV[1],VV[2]));
(void)(putprop(VV[0],VV[3],VV[4]));
(void)(putprop(VV[5],VV[6],VV[4]));
(void)(putprop(VV[7],VV[8],VV[4]));
VV[10]->s.s_stype=(short)stp_special;
if(VV[10]->s.s_dbind == OBJNULL){
VV[10]->s.s_dbind = VV[9];}
VV[11]->s.s_stype=(short)stp_special;
if(VV[11]->s.s_dbind == OBJNULL){
VV[11]->s.s_dbind = VV[9];}
VV[12]->s.s_stype=(short)stp_special;
if(VV[12]->s.s_dbind == OBJNULL){
VV[12]->s.s_dbind = Cnil;}
VV[13]->s.s_stype=(short)stp_special;
if(VV[13]->s.s_dbind == OBJNULL){
VV[13]->s.s_dbind = VV[9];}
VV[14]->s.s_stype=(short)stp_special;
VV[15]->s.s_stype=(short)stp_special;
if(VV[15]->s.s_dbind == OBJNULL){
VV[15]->s.s_dbind = VV[9];}
MF(VV[18],L5,start,size,data);
MF(VV[1],L6,start,size,data);
MF(VV[3],L7,start,size,data);
MF(VV[6],L8,start,size,data);
MF(VV[8],L9,start,size,data);
MF(VV[19],L10,start,size,data);
MF(VV[20],L11,start,size,data);
MF(VV[21],L12,start,size,data);
vs_top=vs_base=base;
}
/* function definition for VS-PUSH */
static L5()
{ register object *base=vs_base;
register object *sup=base+VM3;
vs_reserve(VM3);
check_arg(0);
vs_top=sup;
TTL:;
base[0]= make_cons(symbol_value(VV[15]),symbol_value(VV[10]));
setq(VV[10],number_plus(symbol_value(VV[10]),VV[16]));
setq(VV[11],(number_compare(symbol_value(VV[10]),symbol_value(VV[11]))>=0?symbol_value(VV[10]):symbol_value(VV[11])));
vs_top=(vs_base=base+0)+1;
return;
}
/* function definition for SET-VS */
static L6()
{ register object *base=vs_base;
register object *sup=base+VM4;
vs_reserve(VM4);
check_arg(2);
vs_top=sup;
TTL:;
if(!(type_of(base[0])==t_cons)){
goto T15;}
if(!(car(base[0])==VV[0])){
goto T15;}
if(equal(cadr(base[0]),base[1])){
goto T16;}
T15:;
princ_str("\n ",VV[17]);
base[2]= base[1];
vs_top=(vs_base=base+2)+1;
L7();
vs_top=sup;
princ_str("= ",VV[17]);
base[2]= base[0];
(void)simple_symlispcall_no_event(VV[22],base+2,1);
princ_char(59,VV[17]);
base[2]= Cnil;
vs_top=(vs_base=base+2)+1;
return;
T16:;
base[2]= Cnil;
vs_top=(vs_base=base+2)+1;
return;
}
/* function definition for WT-VS */
static L7()
{ register object *base=vs_base;
register object *sup=base+VM5;
vs_reserve(VM5);
check_arg(1);
vs_top=sup;
TTL:;
if(!(number_compare(car(base[0]),symbol_value(VV[15]))==0)){
goto T30;}
princ_str("base[",VV[17]);
base[1]= cdr(base[0]);
(void)simple_symlispcall_no_event(VV[22],base+1,1);
princ_char(93,VV[17]);
base[1]= Cnil;
vs_top=(vs_base=base+1)+1;
return;
T30:;
princ_str("base",VV[17]);
base[1]= car(base[0]);
(void)simple_symlispcall_no_event(VV[22],base+1,1);
princ_char(91,VV[17]);
base[1]= cdr(base[0]);
(void)simple_symlispcall_no_event(VV[22],base+1,1);
princ_char(93,VV[17]);
base[1]= Cnil;
vs_top=(vs_base=base+1)+1;
return;
}
/* function definition for WT-VS* */
static L8()
{ register object *base=vs_base;
register object *sup=base+VM6;
vs_reserve(VM6);
check_arg(1);
vs_top=sup;
TTL:;
if(!(number_compare(car(base[0]),symbol_value(VV[15]))==0)){
goto T44;}
princ_str("(base[",VV[17]);
base[1]= cdr(base[0]);
(void)simple_symlispcall_no_event(VV[22],base+1,1);
princ_str("]->c.c_car)",VV[17]);
base[1]= Cnil;
vs_top=(vs_base=base+1)+1;
return;
T44:;
princ_str("(base",VV[17]);
base[1]= car(base[0]);
(void)simple_symlispcall_no_event(VV[22],base+1,1);
princ_char(91,VV[17]);
base[1]= cdr(base[0]);
(void)simple_symlispcall_no_event(VV[22],base+1,1);
princ_str("]->c.c_car)",VV[17]);
base[1]= Cnil;
vs_top=(vs_base=base+1)+1;
return;
}
/* function definition for WT-CCB-VS */
static L9()
{ register object *base=vs_base;
register object *sup=base+VM7;
vs_reserve(VM7);
check_arg(1);
vs_top=sup;
TTL:;
princ_str("(base0[",VV[17]);
base[1]= number_minus(symbol_value(VV[14]),base[0]);
(void)simple_symlispcall_no_event(VV[22],base+1,1);
princ_str("]->c.c_car)",VV[17]);
base[1]= Cnil;
vs_top=(vs_base=base+1)+1;
return;
}
/* function definition for CLINK */
static L10()
{ register object *base=vs_base;
register object *sup=base+VM8;
vs_reserve(VM8);
check_arg(1);
vs_top=sup;
TTL:;
setq(VV[12],base[0]);
base[1]= symbol_value(VV[12]);
vs_top=(vs_base=base+1)+1;
return;
}
/* function definition for WT-CLINK */
static L11()
{ register object *base=vs_base;
register object *sup=base+VM9;
vs_reserve(VM9);
if(vs_top-vs_base>1) too_many_arguments();
if(vs_base>=vs_top){vs_top=sup;goto T62;}
vs_top=sup;
goto T63;
T62:;
base[0]= symbol_value(VV[12]);
T63:;
if((base[0])!=Cnil){
goto T66;}
princ_str("Cnil",VV[17]);
base[1]= Cnil;
vs_top=(vs_base=base+1)+1;
return;
T66:;
base[1]= base[0];
vs_top=(vs_base=base+1)+1;
L7();
return;
}
/* function definition for CCB-VS-PUSH */
static L12()
{ register object *base=vs_base;
register object *sup=base+VM10;
vs_reserve(VM10);
check_arg(0);
vs_top=sup;
TTL:;
setq(VV[13],number_plus(symbol_value(VV[13]),VV[16]));
base[0]= symbol_value(VV[13]);
vs_top=(vs_base=base+0)+1;
return;
}